home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Panorama / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].zip / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].adf / makema / maze1.mod < prev    next >
Text File  |  1988-02-13  |  7KB  |  255 lines
  1. MODULE maze1;
  2.  
  3. FROM SYSTEM IMPORT
  4.  ADDRESS, LONGSET, ADR;
  5. FROM Arts IMPORT 
  6.  Terminate, TermProcedure;
  7. FROM Exec IMPORT
  8.  MsgPortPtr,WaitPort,ReplyMsg,GetMsg;
  9. FROM Graphics IMPORT
  10.  Move, Draw, Text, WritePixel;
  11. FROM Intuition IMPORT
  12.  NewWindow, IDCMPFlags, IDCMPFlagSet, ScreenFlags, ScreenFlagSet,
  13.  WindowPtr, WindowFlags, WindowFlagSet, OpenWindow, CloseWindow,
  14.  gadgHNone, Gadget, GadgetPtr, GadgetFlags, GadgetFlagSet, AddGadget,
  15.  propGadget, PropInfo, PropInfoPtr, PropInfoFlags, PropInfoFlagSet,
  16.  Image, ActivationFlags, ActivationFlagSet, IntuiMessagePtr;
  17.  
  18. (* $R- $V- $S- $F- *)              
  19.  
  20. CONST
  21.     xArrayMax = 124;
  22.     yArrayMax = 54;
  23.          
  24. VAR 
  25.     myWindow: WindowPtr;
  26.     myMsg: IntuiMessagePtr;
  27.     st : CHAR;
  28.     sv : ARRAY [1..xArrayMax],[1..yArrayMax] OF CARDINAL;
  29.     fx : ARRAY [1..xArrayMax * yArrayMax DIV 2] OF CARDINAL;
  30.     fy : ARRAY [1..xArrayMax * yArrayMax DIV 2] OF CARDINAL;
  31.     w  : ARRAY [1..4] OF CARDINAL;
  32.     t  : [1..4];
  33.     x, y, xc, yc, rand, flcp, pick, n, back, 
  34.     xmax, ymax, ssz, hsz, p1, p2, i, xb, xe :CARDINAL;
  35.     gp : GadgetPtr;
  36.     propInfo: PropInfo;
  37.     gadget: Gadget;
  38.     image: Image;
  39.  
  40. PROCEDURE CreateGadget(): GadgetPtr;
  41. BEGIN
  42.     WITH propInfo DO
  43.         flags:=PropInfoFlagSet{autoKnob,freeHoriz};
  44.         horizPot:= 0; vertPot:=0;
  45.         horizBody:=100; vertBody:=10;
  46.     END;
  47.     WITH gadget DO
  48.         nextGadget:=NIL;
  49.         leftEdge:=95; topEdge:=12; width:=100; height:=10;
  50.         flags:=GadgetFlagSet{};
  51.         activation:=ActivationFlagSet{};
  52.         gadgetType:=propGadget;
  53.         gadgetRender:=ADR(image);
  54.         selectRender:=NIL; gadgetText:=NIL; mutualExclude:=LONGSET{};
  55.         specialInfo:=ADR(propInfo);
  56.         gadgetID:=0; userData:=NIL;
  57.     END;
  58.     RETURN ADR(gadget)
  59. END CreateGadget;
  60.  
  61. PROCEDURE CreateWindow(x,y,w,h: INTEGER; t: ADDRESS; gp:GadgetPtr): WindowPtr;
  62. VAR
  63.     nw: NewWindow;
  64. BEGIN
  65.     WITH nw DO
  66.         leftEdge:=x; topEdge:=y; width:=w; height:=h;
  67.         detailPen:=0; blockPen:=1; 
  68.         idcmpFlags:=IDCMPFlagSet{closeWindow,newSize};
  69.         flags:=WindowFlagSet{windowClose,simpleRefresh,activate,windowDepth,
  70.                              windowSizing,windowDrag};
  71.         firstGadget:=gp; checkMark:=NIL;
  72.         title:=t;
  73.         screen:=NIL; bitMap:=NIL;
  74.         minWidth:=200; minHeight:=100; maxWidth:=w; maxHeight:=h;
  75.         type:=ScreenFlagSet{wbenchScreen}
  76.     END;
  77.     RETURN OpenWindow(nw)
  78. END CreateWindow;
  79.  
  80. PROCEDURE QSquare ( qx, qy : CARDINAL);
  81. BEGIN
  82.     IF sv[qx,qy] = 0 THEN
  83.        sv[qx,qy] := 128;
  84.        INC(flcp);
  85.        fx[flcp] := qx;
  86.        fy[flcp] := qy;
  87.     END;   
  88. END QSquare;
  89.      
  90. PROCEDURE Line (x1,y1,x2,y2:CARDINAL);
  91. BEGIN        
  92.     Move (myWindow^.rPort,(x1-1)*hsz+10,(y1-1)*ssz+24);
  93.     Draw (myWindow^.rPort,(x2-1)*hsz+10,(y2-1)*ssz+24);
  94. END Line;
  95.           
  96. PROCEDURE Random ( min,range :CARDINAL ): CARDINAL ;
  97. CONST
  98.     m=1024; a=57; c=6999;
  99. BEGIN
  100.     rand:=(CARDINAL(a)* rand +CARDINAL(c)) MOD CARDINAL (m);
  101.     IF range > 1 THEN
  102.        RETURN ((rand DIV 10)MOD range + min);
  103.     ELSE
  104.        RETURN min;
  105.     END;    
  106. END Random;
  107.  
  108. PROCEDURE ReadMsg();
  109. BEGIN
  110.     LOOP
  111.         myMsg:=GetMsg(myWindow^.userPort);
  112.         IF myMsg=NIL THEN
  113.             EXIT
  114.         ELSIF closeWindow IN myMsg^.class THEN
  115.             Terminate(0)
  116.         ELSE
  117.             hsz:=propInfo.horizPot DIV 1024 + 5;
  118.             ssz:=(hsz * 3) DIV 5;
  119.             xmax:=CARDINAL(myWindow^.width - 20) DIV hsz;
  120.             ymax:=CARDINAL(myWindow^.height- 36) DIV ssz;    
  121.         END;
  122.         ReplyMsg(myMsg);
  123.     END;
  124. END ReadMsg; 
  125.  
  126. PROCEDURE Cleanup;
  127. BEGIN
  128.     CloseWindow(myWindow)
  129. END Cleanup;
  130.  
  131. BEGIN   
  132.     TermProcedure(Cleanup);
  133.     xmax:=124; ymax:=54; ssz:=3; hsz:=5;
  134.     gp:=CreateGadget();
  135.     myWindow:=CreateWindow(0,0,640,200,ADR("Muzz's Maze Maker"),gp);
  136.     rand:=71;
  137.     
  138.     REPEAT
  139.         Move(myWindow^.rPort,5,20);
  140.         Text(myWindow^.rPort,ADR("Cell size:"),10);  
  141.  
  142.         flcp:=0;  
  143.         back:=Random(2,14);    
  144.      
  145.      (* choose a starting point randomly *)
  146.         xc := Random (xmax DIV 3 + 1,xmax DIV 3);
  147.         yc := Random (ymax DIV 3 + 1,ymax DIV 3);
  148.         sv[xc,yc] := 64;
  149.  
  150.         REPEAT
  151.          (* add all possible neighbouring squares to queue*)
  152.             IF yc > 1 THEN 
  153.                 QSquare(xc,yc - 1);
  154.             END;
  155.             IF yc < ymax THEN
  156.                 QSquare(xc,yc + 1);
  157.             END;
  158.             IF xc > 1 THEN 
  159.                 QSquare(xc - 1,yc);
  160.             END;
  161.             IF xc < xmax THEN 
  162.                 QSquare(xc + 1,yc);
  163.             END; 
  164.          
  165.          (* pick one to process from the most recent additions *)      
  166.             IF flcp > back THEN 
  167.                 pick := Random(flcp - back,back);
  168.             ELSE   
  169.                 pick := Random(1, flcp);
  170.             END;   
  171.             xc := fx[pick];
  172.             yc := fy[pick];
  173.          
  174.             n:=WritePixel (myWindow^.rPort,(xc-1)*hsz+10,(yc-1)*ssz+24);
  175.          
  176.          (* delete from queue by copying stack top to entry *)      
  177.             fx[pick] := fx[flcp];
  178.             fy[pick] := fy[flcp];
  179.             DEC(flcp);
  180.  
  181.          (* use queue to select random exit from the square *)     
  182.             FOR n := 1 TO 4 DO 
  183.                 w[n] := n
  184.             END;
  185.             n := 4; 
  186.             REPEAT 
  187.              (* search for active path *)
  188.                 x:=xc; y:=yc; p2:=0;
  189.                 pick := Random(1,n);
  190.                 t := w[pick];
  191.                 w[pick] := w[n];
  192.                 DEC(n);
  193.                 CASE t OF
  194.                  (* up *)
  195.                 1 : IF yc > 1 THEN
  196.                         x := xc;
  197.                         y := yc - 1;
  198.                         p2 := 1;
  199.                     END |
  200.                  (* left *)
  201.                 2 : IF xc > 1 THEN 
  202.                         x := xc - 1;
  203.                         y := yc;
  204.                         p2 := 2;
  205.                     END |
  206.                  (* right *)       
  207.                 3 : IF xc < xmax THEN
  208.                         x := xc + 1;
  209.                         y := yc;
  210.                         p2 := 4;
  211.                     END |
  212.                  (* down *)       
  213.                 4 : IF yc < ymax THEN
  214.                         x := xc;
  215.                         y := yc + 1;
  216.                         p2 := 8
  217.                     END 
  218.                 ELSE      
  219.                     Terminate(0)
  220.                 END;       
  221.             UNTIL ((sv[x,y] > 0) AND (sv[x,y] < 128));
  222.  
  223.          (* flag the wall that has to be deleted *)    
  224.             sv[x,y] := sv[x,y] + 8 DIV p2;
  225.             sv[xc,yc] := p2; 
  226.         UNTIL flcp <= 0;
  227.             
  228.      (* establish maze exits *)            
  229.         xb := Random(1,xmax);
  230.         y := 1;
  231.         sv[xb,y] := sv[xb,y] + 1;
  232.         xe := Random(1,xmax);
  233.  
  234.      (* draw maze *)      
  235.         FOR y := 1 TO ymax DO
  236.             FOR x := 1 TO xmax DO
  237.                 p1 := sv[x,y]; sv[x,y] := 0;
  238.                 IF (p1 MOD 2) = 0 THEN 
  239.                     Line(x,y,x+1,y);
  240.                 END;    
  241.                 IF (p1 MOD 4) < 2 THEN 
  242.                     Line (x,y,x,y+1);
  243.                 END;
  244.             END;
  245.         END;
  246.         Line(xmax+1,1,xmax+1,ymax+1);
  247.         Line(1,ymax+1,xe,ymax+1);
  248.         Line(xe+1,ymax+1,xmax+1,ymax+1);
  249.  
  250.         WaitPort(myWindow^.userPort);
  251.         ReadMsg();
  252.     UNTIL myMsg^.class = IDCMPFlagSet{closeWindow};   
  253.    
  254. END maze1.
  255.